structure Assem = struct

  type label = Temp.label

  exception invalidAssemExp;

  type address = {reg:int, offset:int, wback:bool};

  datatype operation =  ADD | SUB | RSB | MUL | MLA |
                        AND | ORR | EOR | CMP | TST |
                        LSL | LSR | ASR | ROR |
                        LDR | STR | LDMFD | STMFD |
                        MRS | MSR |
                        B | BL |
                        SWI | DCD |
                        NOP

  datatype alias = FP | IP | SP | LR | PC

  datatype exp = NAME of Temp.label
               | TEMP of int
               | NCONST of Arbint.int
               | WCONST of Arbint.int
               | PAIR of exp * exp
               | CALL of exp * exp
               | TMEM of int
               | MEM of address
               | REG of int
               | WREG of int
               | ALIAS of alias
               | SHIFT of operation * int

  datatype cond = EQ | NE | GE | LE | GT | LT | AL | NV | CC | LS | HI | CS

  datatype instr = OPER of {oper: operation * cond option * bool,
                            dst: exp list,
                            src: exp list,
                            jump: label list option}
                 | LABEL of {lab: label}
                 | MOVE of {dst: exp,
                            src: exp};

  val indent = "        "

  fun pair2list (PAIR(v1, v2)) =
        (pair2list v1) @ (pair2list v2)
   |  pair2list v = [v]

  fun fromAlias FP = 11
   |  fromAlias IP = 12
   |  fromAlias SP = 13
   |  fromAlias LR = 14
   |  fromAlias PC = 15

  fun toAlias 11 = FP
   |  toAlias 12 = IP
   |  toAlias 13 = SP
   |  toAlias 14 = LR
   |  toAlias 15 = PC
   |  toAlias _ = raise invalidAssemExp

  fun print_op ADD = "ADD"
   |  print_op SUB = "SUB"
   |  print_op RSB = "RSB"
   |  print_op MUL = "MUL"
   |  print_op MLA = "MLA"
   |  print_op AND = "AND"
   |  print_op ORR = "ORR"
   |  print_op EOR = "EOR"
   |  print_op CMP = "CMP"
   |  print_op TST = "TST"
   |  print_op LSL = "LSL"
   |  print_op LSR = "LSR"
   |  print_op ASR = "ASR"
   |  print_op ROR = "ROR"
   |  print_op LDR = "LDR"
   |  print_op LDMFD = "LDMFD"
   |  print_op STR = "STR"
   |  print_op STMFD = "STMFD"
   |  print_op MRS = "MRS"
   |  print_op MSR = "MSR"
   |  print_op BL = "BL"
   |  print_op B = "B"
   |  print_op SWI = "SWI"
   |  print_op NOP = "NOP"
   |  print_op _ = raise invalidAssemExp

   fun print_cond (SOME EQ) = "EQ"
   |  print_cond (SOME NE) = "NE"
   |  print_cond (SOME GE) = "GE"
   |  print_cond (SOME LT) = "LT"
   |  print_cond (SOME GT) = "GT"
   |  print_cond (SOME LE) = "LE"
   |  print_cond (SOME CC) = "CC"
   |  print_cond (SOME LS) = "LS"
   |  print_cond (SOME HI) = "HI"
   |  print_cond (SOME CS) = "CS"
   |  print_cond (SOME AL) = "AL"
   |  print_cond (SOME NV) = "NV"
   |  print_cond NONE = ""


   fun print_flag flag =
      if flag then "S"
      else ""

   fun printAlias FP = "FP"
    |  printAlias IP = "IP"
    |  printAlias SP = "SP"
    |  printAlias LR = "LR"
    |  printAlias PC = "PC"

   val use_alias = ref true;
   val use_capital = ref false;
   val address_stride = ref 1;

   fun printReg r =
        if !use_alias andalso r >= 11 then
           printAlias (toAlias r)
        else "R" ^ Int.toString r

   fun eval_exp (TEMP e) =
            e
    |  eval_exp (NAME e) =
            Symbol.index e
    |  eval_exp (NCONST e) =
            Arbint.toInt e
    |  eval_exp (WCONST e) =
            Arbint.toInt e
    |  eval_exp (TMEM e) =
            e
    |  eval_exp (MEM {reg = r, offset = j, wback = w}) =
            j
    |  eval_exp (REG e) =
            e
    |  eval_exp (WREG e) =
            e
    |  eval_exp (ALIAS e) =
            fromAlias e
    |  eval_exp _ =
            0

    fun toLowerCase str =
                Substring.translate (Char.toString o Char.toLower)
                (Substring.substring (str, 0, String.size str))

    fun one_exp exp =
        let
            fun format_exp (TMEM e) =
                 "[" ^ Int.toString e ^ "]"
             |  format_exp (MEM {reg = r, offset = j, wback = w}) =
                    (if j = 0 then
                        "[" ^ printReg r ^ "]"
                     else
                        "[" ^ printReg r ^ ", " ^ "#" ^ Int.toString (j * !address_stride) ^ "]") ^
                    (if w then "!" else "")
             |  format_exp (TEMP e) =
                        "t" ^ Int.toString e
             |  format_exp (NAME e) =
                        Symbol.name e
             |  format_exp (NCONST e) =
                        "#" ^ Arbint.toString e
             |  format_exp (WCONST e) =
                        "#" ^ (Arbint.toString e) ^ "w"
             |  format_exp (REG e) =
                        printReg e
             |  format_exp (WREG e) =
                        printReg e ^ "!"
             |  format_exp (CALL(f, args)) =
                        "BL " ^ (format_exp f)
             |  format_exp (PAIR(e1,e2)) =
                        "(" ^ format_exp e1 ^ "," ^ format_exp e2 ^ ")"
             |  format_exp _ =
                        raise invalidAssemExp
        in
            if !use_capital then format_exp exp
            else toLowerCase (format_exp exp)
        end

    fun formatInst (OPER {oper = (op1, cond1, flag1), src = sl, dst = dl, jump = jl}) =
        let
            fun appendBlanks i = if i <= 0 then "" else " " ^ appendBlanks (i-1)

            val (sl,dl) = if op1 = LDMFD orelse op1 = STR then (dl,sl)
                          else if op1 = CMP then (sl,[])
                          else (sl,dl)

            val ops0 = (print_op op1 ^ print_cond cond1 ^ print_flag flag1)
            val ops1 = ops0 ^ appendBlanks (8 - String.size ops0)

            val inst =
                indent ^ ops1 ^

                (
                 if op1 = STMFD orelse op1 = LDMFD then
                        (one_exp (hd dl)) ^ ", {" ^ one_exp (hd sl) ^
                                        (List.foldl (fn (n,s) => (s ^ "," ^ one_exp n)) "" (tl sl)) ^ "}"
                 else if op1 = BL then
                        (if null dl then ""
                         else
                            "(" ^ one_exp (hd dl) ^ (List.foldl (fn (n,s) => (s ^ "," ^ one_exp n)) "" (tl dl)) ^ "), " ^
                            "(" ^ one_exp (hd sl) ^ (List.foldl (fn (n,s) => (s ^ "," ^ one_exp n)) "" (tl sl)) ^ ")"
                        ) ^
                        Symbol.name (hd (valOf jl)) ^ " (" ^ Int.toString (Symbol.index (hd (valOf jl))) ^ ")"
                 else
                        (if null dl then "" else (one_exp (hd dl))) ^
                        (if null sl orelse op1 = B then ""
                         else if null dl then (one_exp (hd sl))
                         else ", " ^ (one_exp (hd sl))
                        ) ^
                        (if null sl then ""
                         else List.foldl (fn (v,s) => s ^ ", " ^ (one_exp v)) "" (tl sl)) ^
                        (case jl of
                              NONE => ""
                           |  SOME labs => Symbol.name (hd labs) ^ " (" ^ Int.toString (Symbol.index (hd labs)) ^ ")")
                        )
        in
            if !use_capital then inst
            else toLowerCase inst
        end

   |  formatInst (LABEL {lab = v}) = Symbol.name v ^ ":"

   |  formatInst (MOVE {src = s, dst = d}) =
        let val inst =  indent ^ "MOV     " ^ (one_exp d) ^ ", " ^ (one_exp s)
        in
            if !use_capital then inst
            else toLowerCase inst
        end

(* ---------------------------------------------------------------------------------------------------------------------*)
(* Print ARM programs                                                                                                   *)
(* ---------------------------------------------------------------------------------------------------------------------*)

val lineNo = ref ~1;

fun printInsts stms =
  let
      fun formatNextLineNo () =
          ( lineNo := !lineNo + 1;
            "  " ^
            ( if !lineNo < 10 then "  " ^ Int.toString (!lineNo)
              else if !lineNo < 100 then " " ^ Int.toString (!lineNo)
              else Int.toString (!lineNo)
            ) ^
            ":"
          )
  in
      (lineNo := ~1;
       List.map (fn stm => print ((formatNextLineNo() ^  "  " ^ formatInst stm) ^ "\n")) stms
      )
  end

val print_structure = ref true;

fun printarm progL =
   let
       val _ = lineNo := ~1;
       fun one_fun flag(fname,ftype,args,stms,outs,rs) =
         (
          (if flag then
              ( print "*****************************************************************\n";
                print ("  Name              : " ^ fname ^ "\n");
                print "  Arguments         : ";
                List.map (fn arg => print (one_exp arg ^ " ")) (pair2list args);
                print "\n  Modified Registers: ";
                List.map (fn arg => print (one_exp arg ^ " ")) (Binaryset.listItems rs);
                print "\n  Returns           : ";
                List.map (fn arg => print (one_exp arg ^ " ")) (pair2list outs);
                print "\n  Body: \n"
              )
           else print "");
          printInsts stms
         )
   in
      ( one_fun true (hd progL);
        List.map (one_fun (!print_structure)) (tl progL)
      )
   end

end

